!|author: <a href="mailto:townsend@astro.wisc.edu">Rich Townsend</a>
! license: <a href="http://www.gnu.org/licenses/">LGPL</a>
! iso_varying_string.f90
!
! Copyright (C) 2003 Rich Townsend <townsend@astro.wisc.edu>
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU Lesser General Public
! License as published by the Free Software Foundation; either
! version 2.1 of the License, or (at your option) any later
! version.
!
! This program is distributed in the hope that it will be
! useful, but WITHOUT ANY WARRANTY; without even the implied
! warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
! PURPOSE. See the GNU Lesser General Public License for more
! details.
!
! You should have received a copy of the GNU Lesser General
! Public License along with this program; if not, write to the
! Free Software Foundation, Inc., 59 Temple Place, Suite 330,
! Boston, MA 02111-1307 USA
!
! *****************************************************************
!
! Developer : Rich Townsend <townsend@astro.wisc.edu>
!
! Synopsis : Definition of iso_varying_string module, conformant to
! the API specified in ISO/IEC 1539-2:2000 (varying-length
! strings for Fortran 95).
!
! Notes : This implementation of iso_varying_string is designed to avoid
! the possibility of memory leaks. To achieve this, it takes
! advantage of language extensions specified in ISO/IEC
! TR 15581 (enhanced data type facilities). Many vendors
! support these extensions, and they will form a core part
! of Fortran 2000.
!
! Version : 1.2
!
! Thanks : Lawrie Schonfelder's iso_varying_string module provided me
! with much insight on how to go about writing this module,
! for which I am very grateful. Furthermore, Lawrie helped
! point out some subtle bugs in the module.
!
module iso_varying_string
! No implicit typing
implicit none
! Parameter definitions
integer, parameter :: GET_BUFFER_LEN = 256
! Type definitions
type varying_string
private
character(LEN=1), dimension(:), allocatable :: chars
end type varying_string
! Interface blocks
interface assignment(=)
module procedure op_assign_CH_VS
module procedure op_assign_VS_CH
end interface assignment(=)
interface operator(//)
module procedure op_concat_VS_VS
module procedure op_concat_CH_VS
module procedure op_concat_VS_CH
end interface operator(//)
interface operator(==)
module procedure op_eq_VS_VS
module procedure op_eq_CH_VS
module procedure op_eq_VS_CH
end interface operator(==)
interface operator(/=)
module procedure op_ne_VS_VS
module procedure op_ne_CH_VS
module procedure op_ne_VS_CH
end interface operator (/=)
interface operator(<)
module procedure op_lt_VS_VS
module procedure op_lt_CH_VS
module procedure op_lt_VS_CH
end interface operator (<)
interface operator(<=)
module procedure op_le_VS_VS
module procedure op_le_CH_VS
module procedure op_le_VS_CH
end interface operator (<=)
interface operator(>=)
module procedure op_ge_VS_VS
module procedure op_ge_CH_VS
module procedure op_ge_VS_CH
end interface operator (>=)
interface operator(>)
module procedure op_gt_VS_VS
module procedure op_gt_CH_VS
module procedure op_gt_VS_CH
end interface operator (>)
interface adjustl
module procedure adjustl_
end interface adjustl
interface adjustr
module procedure adjustr_
end interface adjustr
interface char
module procedure char_auto
module procedure char_fixed
end interface char
interface iachar
module procedure iachar_
end interface iachar
interface ichar
module procedure ichar_
end interface ichar
interface index
module procedure index_VS_VS
module procedure index_CH_VS
module procedure index_VS_CH
end interface index
interface len
module procedure len_
end interface len
interface len_trim
module procedure len_trim_
end interface len_trim
interface lge
module procedure lge_VS_VS
module procedure lge_CH_VS
module procedure lge_VS_CH
end interface lge
interface lgt
module procedure lgt_VS_VS
module procedure lgt_CH_VS
module procedure lgt_VS_CH
end interface lgt
interface lle
module procedure lle_VS_VS
module procedure lle_CH_VS
module procedure lle_VS_CH
end interface lle
interface llt
module procedure llt_VS_VS
module procedure llt_CH_VS
module procedure llt_VS_CH
end interface llt
interface repeat
module procedure repeat_
end interface repeat
interface scan
module procedure scan_VS_VS
module procedure scan_CH_VS
module procedure scan_VS_CH
end interface scan
interface trim
module procedure trim_
end interface trim
interface verify
module procedure verify_VS_VS
module procedure verify_CH_VS
module procedure verify_VS_CH
end interface verify
interface var_str
module procedure var_str_
end interface var_str
interface get
module procedure get_
module procedure get_unit
module procedure get_set_VS
module procedure get_set_CH
module procedure get_unit_set_VS
module procedure get_unit_set_CH
end interface get
interface put
module procedure put_VS
module procedure put_CH
module procedure put_unit_VS
module procedure put_unit_CH
end interface put
interface put_line
module procedure put_line_VS
module procedure put_line_CH
module procedure put_line_unit_VS
module procedure put_line_unit_CH
end interface put_line
interface extract
module procedure extract_VS
module procedure extract_CH
end interface extract
interface insert
module procedure insert_VS_VS
module procedure insert_CH_VS
module procedure insert_VS_CH
module procedure insert_CH_CH
end interface insert
interface remove
module procedure remove_VS
module procedure remove_CH
end interface remove
interface replace
module procedure replace_VS_VS_auto
module procedure replace_CH_VS_auto
module procedure replace_VS_CH_auto
module procedure replace_CH_CH_auto
module procedure replace_VS_VS_fixed
module procedure replace_CH_VS_fixed
module procedure replace_VS_CH_fixed
module procedure replace_CH_CH_fixed
module procedure replace_VS_VS_VS_target
module procedure replace_CH_VS_VS_target
module procedure replace_VS_CH_VS_target
module procedure replace_CH_CH_VS_target
module procedure replace_VS_VS_CH_target
module procedure replace_CH_VS_CH_target
module procedure replace_VS_CH_CH_target
module procedure replace_CH_CH_CH_target
end interface
interface split
module procedure split_VS
module procedure split_CH
end interface split
! Access specifiers
private
public :: varying_string
public :: assignment(=)
public :: operator(//)
public :: operator(==)
public :: operator(/=)
public :: operator(<)
public :: operator(<=)
public :: operator(>=)
public :: operator(>)
public :: adjustl
public :: adjustr
public :: char
public :: iachar
public :: ichar
public :: index
public :: len
public :: len_trim
public :: lge
public :: lgt
public :: lle
public :: llt
public :: repeat
public :: scan
public :: trim
public :: verify
public :: var_str
public :: get
public :: put
public :: put_line
public :: extract
public :: insert
public :: remove
public :: replace
public :: split
! Procedures
contains
!| Assign a varying string to a character string
elemental subroutine op_assign_CH_VS (var, exp)
character(LEN=*), intent(out) :: var
type(varying_string), intent(in) :: exp
var = char(exp)
! Finish
return
end subroutine op_assign_CH_VS
!| Assign a character string to a varying string
!
elemental subroutine op_assign_VS_CH (var, exp)
type(varying_string), intent(out) :: var
character(LEN=*), intent(in) :: exp
var = var_str(exp)
! Finish
return
end subroutine op_assign_VS_CH
!| Concatenate two varying strings
!
elemental function op_concat_VS_VS (string_a, string_b) result (concat_string)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
type(varying_string) :: concat_string
integer :: len_string_a
len_string_a = len(string_a)
ALLOCATE(concat_string%chars(len_string_a+len(string_b)))
concat_string%chars(:len_string_a) = string_a%chars
concat_string%chars(len_string_a+1:) = string_b%chars
! Finish
return
end function op_concat_VS_VS
!| Concatenate a character string and a varying
! string
!
elemental function op_concat_CH_VS (string_a, string_b) result (concat_string)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
type(varying_string) :: concat_string
concat_string = op_concat_VS_VS(var_str(string_a), string_b)
! Finish
return
end function op_concat_CH_VS
!| Concatenate a varying string and a character
! string
elemental function op_concat_VS_CH (string_a, string_b) result (concat_string)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
type(varying_string) :: concat_string
concat_string = op_concat_VS_VS(string_a, var_str(string_b))
! Finish
return
end function op_concat_VS_CH
!| Compare (==) two varying strings
!
elemental function op_eq_VS_VS (string_a, string_b) result (op_eq)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_eq
op_eq = char(string_a) == char(string_b)
! Finish
return
end function op_eq_VS_VS
!| Compare (==) a character string and a varying
! string
!
elemental function op_eq_CH_VS (string_a, string_b) result (op_eq)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_eq
op_eq = string_a == char(string_b)
! Finish
return
end function op_eq_CH_VS
!| Compare (==) a varying string and a character string
!
elemental function op_eq_VS_CH (string_a, string_b) result (op_eq)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
logical :: op_eq
op_eq = char(string_a) == string_b
! Finish
return
end function op_eq_VS_CH
!| Compare (/=) two varying strings
!
elemental function op_ne_VS_VS (string_a, string_b) result (op_ne)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_ne
op_ne = char(string_a) /= char(string_b)
! Finish
return
end function op_ne_VS_VS
!| Compare (/=) a character string and a varying string
!
elemental function op_ne_CH_VS (string_a, string_b) result (op_ne)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_ne
op_ne = string_a /= char(string_b)
! Finish
return
end function op_ne_CH_VS
!| Compare (/=) a varying string and a character string
!
elemental function op_ne_VS_CH (string_a, string_b) result (op_ne)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
logical :: op_ne
op_ne = char(string_a) /= string_b
! Finish
return
end function op_ne_VS_CH
!| Compare (<) two varying strings
!
elemental function op_lt_VS_VS (string_a, string_b) result (op_lt)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_lt
op_lt = char(string_a) < char(string_b)
! Finish
return
end function op_lt_VS_VS
!| Compare (<) a character string and a varying string
!
elemental function op_lt_CH_VS (string_a, string_b) result (op_lt)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_lt
op_lt = string_a < char(string_b)
! Finish
return
end function op_lt_CH_VS
!| Compare (<) a varying string and a character string
!
elemental function op_lt_VS_CH (string_a, string_b) result (op_lt)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
logical :: op_lt
op_lt = char(string_a) < string_b
! Finish
return
end function op_lt_VS_CH
!| Compare (<=) two varying strings
!
elemental function op_le_VS_VS (string_a, string_b) result (op_le)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_le
op_le = char(string_a) <= char(string_b)
! Finish
return
end function op_le_VS_VS
!| Compare (<=) a character string and a varying string
!
elemental function op_le_CH_VS (string_a, string_b) result (op_le)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_le
op_le = string_a <= char(string_b)
! Finish
return
end function op_le_CH_VS
!| Compare (<=) a varying string and a character string
!
elemental function op_le_VS_CH (string_a, string_b) result (op_le)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
logical :: op_le
op_le = char(string_a) <= string_b
! Finish
return
end function op_le_VS_CH
!| Compare (>=) two varying strings
!
elemental function op_ge_VS_VS (string_a, string_b) result (op_ge)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_ge
op_ge = char(string_a) >= char(string_b)
! Finish
return
end function op_ge_VS_VS
!| Compare (>=) a character string and a varying string
!
elemental function op_ge_CH_VS (string_a, string_b) result (op_ge)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_ge
op_ge = string_a >= char(string_b)
! Finish
return
end function op_ge_CH_VS
!| Compare (>=) a varying string and a character string
!
elemental function op_ge_VS_CH (string_a, string_b) result (op_ge)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
logical :: op_ge
op_ge = char(string_a) >= string_b
! Finish
return
end function op_ge_VS_CH
!| Compare (>) two varying strings
!
elemental function op_gt_VS_VS (string_a, string_b) result (op_gt)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_gt
op_gt = char(string_a) > char(string_b)
! Finish
return
end function op_gt_VS_VS
!| Compare (>) a character string and a varying string
!
elemental function op_gt_CH_VS (string_a, string_b) result (op_gt)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: op_gt
op_gt = string_a > char(string_b)
! Finish
return
end function op_gt_CH_VS
!| Compare (>) a varying string and a character string
!
elemental function op_gt_VS_CH (string_a, string_b) result (op_gt)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
logical :: op_gt
op_gt = char(string_a) > string_b
! Finish
return
end function op_gt_VS_CH
!| Adjust the varying string to the left
!
elemental function adjustl_ (string) result (adjustl_string)
type(varying_string), intent(in) :: string
type(varying_string) :: adjustl_string
adjustl_string = ADJUSTL(CHAR(string))
! Finish
return
end function adjustl_
!| Adjust the varying string to the right
!
elemental function adjustr_ (string) result (adjustr_string)
type(varying_string), intent(in) :: string
type(varying_string) :: adjustr_string
adjustr_string = ADJUSTR(CHAR(string))
! Finish
return
end function adjustr_
!| Convert a varying string into a character string
! (automatic length)
!
pure function char_auto (string) result (char_string)
type(varying_string), intent(in) :: string
character(LEN=len(string)) :: char_string
integer :: i_char
forall(i_char = 1:len(string))
char_string(i_char:i_char) = string%chars(i_char)
end forall
! Finish
return
end function char_auto
!| Convert a varying string into a character string
! (fixed length)
pure function char_fixed (string, length) result (char_string)
type(varying_string), intent(in) :: string
integer, intent(in) :: length
character(LEN=length) :: char_string
char_string = char(string)
! Finish
return
end function char_fixed
!| Get the position in the ISO 646 collating sequence
! of a varying string character
!
elemental function iachar_ (c) result (i)
type(varying_string), intent(in) :: c
integer :: i
i = IACHAR(char(c))
! Finish
return
end function iachar_
!| Get the position in the processor collating
! sequence of a varying string character
!
elemental function ichar_ (c) result (i)
type(varying_string), intent(in) :: c
integer :: i
i = ICHAR(char(c))
! Finish
return
end function ichar_
!| Get the index of a varying substring within a
! varying string
!
elemental function index_VS_VS (string, substring, back) result (i_substring)
type(varying_string), intent(in) :: string
type(varying_string), intent(in) :: substring
logical, intent(in), optional :: back
integer :: i_substring
i_substring = INDEX(char(string), char(substring), back)
! Finish
return
end function index_VS_VS
!| Get the index of a varying substring within a
! character string
!
elemental function index_CH_VS (string, substring, back) result (i_substring)
character(LEN=*), intent(in) :: string
type(varying_string), intent(in) :: substring
logical, intent(in), optional :: back
integer :: i_substring
i_substring = INDEX(string, char(substring), back)
! Finish
return
end function index_CH_VS
!| Get the index of a character substring within a
! varying string
!
elemental function index_VS_CH (string, substring, back) result (i_substring)
type(varying_string), intent(in) :: string
character(LEN=*), intent(in) :: substring
logical, intent(in), optional :: back
integer :: i_substring
i_substring = INDEX(char(string), substring, back)
! Finish
return
end function index_VS_CH
!| Get the length of a varying string
!
elemental function len_ (string) result (length)
type(varying_string), intent(in) :: string
integer :: length
if(ALLOCATED(string%chars)) then
length = SIZE(string%chars)
else
length = 0
endif
! Finish
return
end function len_
!| Get the trimmed length of a varying string
!
elemental function len_trim_ (string) result (length)
type(varying_string), intent(in) :: string
integer :: length
if(ALLOCATED(string%chars)) then
length = LEN_TRIM(char(string))
else
length = 0
endif
! Finish
return
end function len_trim_
!| Compare (LGE) two varying strings
!
elemental function lge_VS_VS (string_a, string_b) result (comp)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: comp
comp = LGE(char(string_a), char(string_b))
! Finish
return
end function lge_VS_VS
!| Compare (LGE) a character string and a varying string
!
elemental function lge_CH_VS (string_a, string_b) result (comp)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: comp
comp = LGE(string_a, char(string_b))
! Finish
return
end function lge_CH_VS
!| Compare (LGE) a varying string and a character string
!
elemental function lge_VS_CH (string_a, string_b) result (comp)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
logical :: comp
comp = LGE(char(string_a), string_b)
! Finish
return
end function lge_VS_CH
!| Compare (LGT) two varying strings
!
elemental function lgt_VS_VS (string_a, string_b) result (comp)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: comp
comp = LGT(char(string_a), char(string_b))
! Finish
return
end function lgt_VS_VS
!| Compare (LGT) a character string and a varying string
!
elemental function lgt_CH_VS (string_a, string_b) result (comp)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: comp
comp = LGT(string_a, char(string_b))
! Finish
return
end function lgt_CH_VS
!| Compare (LGT) a varying string and a character string
!
elemental function lgt_VS_CH (string_a, string_b) result (comp)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
logical :: comp
comp = LGT(char(string_a), string_b)
! Finish
return
end function lgt_VS_CH
!| Compare (LLE) two varying strings
!
elemental function lle_VS_VS (string_a, string_b) result (comp)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: comp
comp = LLE(char(string_a), char(string_b))
! Finish
return
end function lle_VS_VS
!| Compare (LLE) a character string and a varying string
!
elemental function lle_CH_VS (string_a, string_b) result (comp)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: comp
comp = LLE(string_a, char(string_b))
! Finish
return
end function lle_CH_VS
!| Compare (LLE) a varying string and a character string
!
elemental function lle_VS_CH (string_a, string_b) result (comp)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
logical :: comp
comp = LLE(char(string_a), string_b)
! Finish
return
end function lle_VS_CH
!| Compare (LLT) two varying strings
!
elemental function llt_VS_VS (string_a, string_b) result (comp)
type(varying_string), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: comp
comp = LLT(char(string_a), char(string_b))
! Finish
return
end function llt_VS_VS
!| Compare (LLT) a character string and a varying string
!
elemental function llt_CH_VS (string_a, string_b) result (comp)
character(LEN=*), intent(in) :: string_a
type(varying_string), intent(in) :: string_b
logical :: comp
comp = LLT(string_a, char(string_b))
! Finish
return
end function llt_CH_VS
!| Compare (LLT) a varying string and a character string
!
elemental function llt_VS_CH (string_a, string_b) result (comp)
type(varying_string), intent(in) :: string_a
character(LEN=*), intent(in) :: string_b
logical :: comp
comp = LLT(char(string_a), string_b)
! Finish
return
end function llt_VS_CH
!| Concatenate several copies of a varying string
!
elemental function repeat_ (string, ncopies) result (repeat_string)
type(varying_string), intent(in) :: string
integer, intent(in) :: ncopies
type(varying_string) :: repeat_string
repeat_string = var_str(REPEAT(char(string), ncopies))
! Finish
return
end function repeat_
!| Scan a varying string for occurrences of
! characters in a varying-string set
!
elemental function scan_VS_VS (string, set, back) result (i)
type(varying_string), intent(in) :: string
type(varying_string), intent(in) :: set
logical, intent(in), optional :: back
integer :: i
i = SCAN(char(string), char(set), back)
! Finish
return
end function scan_VS_VS
!| Scan a character string for occurrences of
! characters in a varying-string set
!
elemental function scan_CH_VS (string, set, back) result (i)
character(LEN=*), intent(in) :: string
type(varying_string), intent(in) :: set
logical, intent(in), optional :: back
integer :: i
i = SCAN(string, char(set), back)
! Finish
return
end function scan_CH_VS
!| Scan a varying string for occurrences of
! characters in a character-string set
!
elemental function scan_VS_CH (string, set, back) result (i)
type(varying_string), intent(in) :: string
character(LEN=*), intent(in) :: set
logical, intent(in), optional :: back
integer :: i
i = SCAN(char(string), set, back)
! Finish
return
end function scan_VS_CH
!| Remove trailing blanks from a varying string
!
elemental function trim_ (string) result (trim_string)
type(varying_string), intent(in) :: string
type(varying_string) :: trim_string
trim_string = TRIM(char(string))
! Finish
return
end function trim_
!| Verify a varying string for occurrences of
! characters in a varying-string set
!
elemental function verify_VS_VS (string, set, back) result (i)
type(varying_string), intent(in) :: string
type(varying_string), intent(in) :: set
logical, intent(in), optional :: back
integer :: i
i = VERIFY(char(string), char(set), back)
! Finish
return
end function verify_VS_VS
!| Verify a character string for occurrences of
! characters in a varying-string set
!
elemental function verify_CH_VS (string, set, back) result (i)
character(LEN=*), intent(in) :: string
type(varying_string), intent(in) :: set
logical, intent(in), optional :: back
integer :: i
i = VERIFY(string, char(set), back)
! Finish
return
end function verify_CH_VS
!| Verify a varying string for occurrences of
! characters in a character-string set
!
elemental function verify_VS_CH (string, set, back) result (i)
type(varying_string), intent(in) :: string
character(LEN=*), intent(in) :: set
logical, intent(in), optional :: back
integer :: i
i = VERIFY(char(string), set, back)
! Finish
return
end function verify_VS_CH
!| Convert a character string to a varying string
!
elemental function var_str_ (char) result (string)
character(LEN=*), intent(in) :: char
type(varying_string) :: string
integer :: length
integer :: i_char
length = LEN(char)
ALLOCATE(string%chars(length))
forall(i_char = 1:length)
string%chars(i_char) = char(i_char:i_char)
end forall
! Finish
return
end function var_str_
!| Read from the default unit into a varying string
!
subroutine get_ (string, maxlen, iostat)
type(varying_string), intent(out) :: string
integer, intent(in), optional :: maxlen
integer, intent(out), optional :: iostat
integer :: n_chars_remain
integer :: n_chars_read
character(LEN=GET_BUFFER_LEN) :: buffer
string = ''
if(PRESENT(maxlen)) then
n_chars_remain = maxlen
else
n_chars_remain = HUGE(1)
endif
read_loop : do
if(n_chars_remain <= 0) return
n_chars_read = MIN(n_chars_remain, GET_BUFFER_LEN)
if(PRESENT(iostat)) then
read(*, FMT='(A)', ADVANCE='NO', IOSTAT=iostat, SIZE=n_chars_read) buffer(:n_chars_read)
if(iostat < 0) exit read_loop
if(iostat > 0) return
else
read(*, FMT='(A)', ADVANCE='NO', EOR=999, SIZE=n_chars_read) buffer(:n_chars_read)
endif
string = string//buffer(:n_chars_read)
n_chars_remain = n_chars_remain - n_chars_read
end do read_loop
999 continue
string = string//buffer(:n_chars_read)
! Finish (end-of-record)
return
end subroutine get_
!| Read from the specified unit into a varying string
!
subroutine get_unit (unit, string, maxlen, iostat)
integer, intent(in) :: unit
type(varying_string), intent(out) :: string
integer, intent(in), optional :: maxlen
integer, intent(out), optional :: iostat
integer :: n_chars_remain
integer :: n_chars_read
character(LEN=GET_BUFFER_LEN) :: buffer
string = ''
if(PRESENT(maxlen)) then
n_chars_remain = maxlen
else
n_chars_remain = HUGE(1)
endif
read_loop : do
if(n_chars_remain <= 0) return
n_chars_read = MIN(n_chars_remain, GET_BUFFER_LEN)
if(PRESENT(iostat)) then
read(unit, FMT='(A)', ADVANCE='NO', IOSTAT=iostat, SIZE=n_chars_read) buffer(:n_chars_read)
if(iostat < 0) exit read_loop
if(iostat > 0) return
else
read(unit, FMT='(A)', ADVANCE='NO', EOR=999, SIZE=n_chars_read) buffer(:n_chars_read)
endif
string = string//buffer(:n_chars_read)
n_chars_remain = n_chars_remain - n_chars_read
end do read_loop
999 continue
string = string//buffer(:n_chars_read)
! Finish (end-of-record)
return
end subroutine get_unit
!| Read from the default unit into a varying string,
! with a custom varying-string separator
!
subroutine get_set_VS (string, set, separator, maxlen, iostat)
type(varying_string), intent(out) :: string
type(varying_string), intent(in) :: set
type(varying_string), intent(out), optional :: separator
integer, intent(in), optional :: maxlen
integer, intent(out), optional :: iostat
call get(string, char(set), separator, maxlen, iostat)
! Finish
return
end subroutine get_set_VS
!| Read from the default unit into a varying string,
! with a custom character-string separator
!
subroutine get_set_CH (string, set, separator, maxlen, iostat)
type(varying_string), intent(out) :: string
character(LEN=*), intent(in) :: set
type(varying_string), intent(out), optional :: separator
integer, intent(in), optional :: maxlen
integer, intent(out), optional :: iostat
integer :: n_chars_remain
character(LEN=1) :: buffer
integer :: i_set
string = ''
if(PRESENT(maxlen)) then
n_chars_remain = maxlen
else
n_chars_remain = HUGE(1)
endif
if(PRESENT(separator)) separator = ''
read_loop : do
if(n_chars_remain <= 0) return
if(PRESENT(iostat)) then
read(*, FMT='(A1)', ADVANCE='NO', IOSTAT=iostat) buffer
if(iostat /= 0) exit read_loop
else
read(*, FMT='(A1)', ADVANCE='NO', EOR=999) buffer
endif
i_set = SCAN(buffer, set)
if(i_set == 1) then
if(PRESENT(separator)) separator = buffer
exit read_loop
endif
string = string//buffer
n_chars_remain = n_chars_remain - 1
end do read_loop
999 continue
! Finish
return
end subroutine get_set_CH
!| Read from the specified unit into a varying string,
! with a custom varying-string separator
!
subroutine get_unit_set_VS (unit, string, set, separator, maxlen, iostat)
integer, intent(in) :: unit
type(varying_string), intent(out) :: string
type(varying_string), intent(in) :: set
type(varying_string), intent(out), optional :: separator
integer, intent(in), optional :: maxlen
integer, intent(out), optional :: iostat
call get(unit, string, char(set), separator, maxlen, iostat)
! Finish
return
end subroutine get_unit_set_VS
!| Read from the default unit into a varying string,
! with a custom character-string separator
!
subroutine get_unit_set_CH (unit, string, set, separator, maxlen, iostat)
integer, intent(in) :: unit
type(varying_string), intent(out) :: string
character(LEN=*), intent(in) :: set
type(varying_string), intent(out), optional :: separator
integer, intent(in), optional :: maxlen
integer, intent(out), optional :: iostat
integer :: n_chars_remain
character(LEN=1) :: buffer
integer :: i_set
string = ''
if(PRESENT(maxlen)) then
n_chars_remain = maxlen
else
n_chars_remain = HUGE(1)
endif
if(PRESENT(separator)) separator = ''
read_loop : do
if(n_chars_remain <= 0) return
if(PRESENT(iostat)) then
read(unit, FMT='(A1)', ADVANCE='NO', IOSTAT=iostat) buffer
if(iostat /= 0) exit read_loop
else
read(unit, FMT='(A1)', ADVANCE='NO', EOR=999) buffer
endif
i_set = SCAN(buffer, set)
if(i_set == 1) then
if(PRESENT(separator)) separator = buffer
exit read_loop
endif
string = string//buffer
n_chars_remain = n_chars_remain - 1
end do read_loop
999 continue
! Finish
return
end subroutine get_unit_set_CH
!| Append a varying string to the current record of
! the default unit
!
subroutine put_VS (string, iostat)
type(varying_string), intent(in) :: string
integer, intent(out), optional :: iostat
call put(char(string), iostat)
! Finish
end subroutine put_VS
!| Append a character string to the current record of
! the default unit
!
subroutine put_CH (string, iostat)
character(LEN=*), intent(in) :: string
integer, intent(out), optional :: iostat
if(PRESENT(iostat)) then
write(*, FMT='(A)', ADVANCE='NO', IOSTAT=iostat) string
else
write(*, FMT='(A)', ADVANCE='NO') string
endif
! Finish
end subroutine put_CH
!| Append a varying string to the current record of
! the specified unit
!
subroutine put_unit_VS (unit, string, iostat)
integer, intent(in) :: unit
type(varying_string), intent(in) :: string
integer, intent(out), optional :: iostat
call put(unit, char(string), iostat)
! Finish
return
end subroutine put_unit_VS
!| Append a character string to the current record of
! the specified unit
!
subroutine put_unit_CH (unit, string, iostat)
integer, intent(in) :: unit
character(LEN=*), intent(in) :: string
integer, intent(out), optional :: iostat
if(PRESENT(iostat)) then
write(unit, FMT='(A)', ADVANCE='NO', IOSTAT=iostat) string
else
write(unit, FMT='(A)', ADVANCE='NO') string
endif
! Finish
return
end subroutine put_unit_CH
!| Append a varying string to the current record of
! the default unit, terminating the record
!
subroutine put_line_VS (string, iostat)
type(varying_string), intent(in) :: string
integer, intent(out), optional :: iostat
call put_line(char(string), iostat)
! Finish
return
end subroutine put_line_VS
!| Append a varying string to the current record of
! the default unit, terminating the record
!
subroutine put_line_CH (string, iostat)
character(LEN=*), intent(in) :: string
integer, intent(out), optional :: iostat
if(PRESENT(iostat)) then
write(*, FMT='(A,/)', ADVANCE='NO', IOSTAT=iostat) string
else
write(*, FMT='(A,/)', ADVANCE='NO') string
endif
! Finish
return
end subroutine put_line_CH
!| Append a varying string to the current record of
! the specified unit, terminating the record
!
subroutine put_line_unit_VS (unit, string, iostat)
integer, intent(in) :: unit
type(varying_string), intent(in) :: string
integer, intent(out), optional :: iostat
call put_line(unit, char(string), iostat)
! Finish
return
end subroutine put_line_unit_VS
!| Append a varying string to the current record of
! the specified unit, terminating the record
!
subroutine put_line_unit_CH (unit, string, iostat)
integer, intent(in) :: unit
character(LEN=*), intent(in) :: string
integer, intent(out), optional :: iostat
if(PRESENT(iostat)) then
write(unit, FMT='(A,/)', ADVANCE='NO', IOSTAT=iostat) string
else
write(unit, FMT='(A,/)', ADVANCE='NO') string
endif
! Finish
return
end subroutine put_line_unit_CH
!| Extract a varying substring from a varying string
!
elemental function extract_VS (string, start, finish) result (ext_string)
type(varying_string), intent(in) :: string
integer, intent(in), optional :: start
integer, intent(in), optional :: finish
type(varying_string) :: ext_string
ext_string = extract(char(string), start, finish)
! Finish
return
end function extract_VS
!| Extract a varying substring from a character string
!
elemental function extract_CH (string, start, finish) result (ext_string)
character(LEN=*), intent(in) :: string
integer, intent(in), optional :: start
integer, intent(in), optional :: finish
type(varying_string) :: ext_string
integer :: start_
integer :: finish_
if(PRESENT(start)) then
start_ = MAX(1, start)
else
start_ = 1
endif
if(PRESENT(finish)) then
finish_ = MIN(LEN(string), finish)
else
finish_ = LEN(string)
endif
ext_string = var_str(string(start_:finish_))
! Finish
return
end function extract_CH
!| Insert a varying substring into a varying string
!
elemental function insert_VS_VS (string, start, substring) result (ins_string)
type(varying_string), intent(in) :: string
integer, intent(in) :: start
type(varying_string), intent(in) :: substring
type(varying_string) :: ins_string
ins_string = insert(char(string), start, char(substring))
! Finish
return
end function insert_VS_VS
!| Insert a varying substring into a character string
!
elemental function insert_CH_VS (string, start, substring) result (ins_string)
character(LEN=*), intent(in) :: string
integer, intent(in) :: start
type(varying_string), intent(in) :: substring
type(varying_string) :: ins_string
ins_string = insert(string, start, char(substring))
! Finish
return
end function insert_CH_VS
!| Insert a character substring into a varying string
!
elemental function insert_VS_CH (string, start, substring) result (ins_string)
type(varying_string), intent(in) :: string
integer, intent(in) :: start
character(LEN=*), intent(in) :: substring
type(varying_string) :: ins_string
ins_string = insert(char(string), start, substring)
! Finish
return
end function insert_VS_CH
!| Insert a character substring into a character string
!
elemental function insert_CH_CH (string, start, substring) result (ins_string)
character(LEN=*), intent(in) :: string
integer, intent(in) :: start
character(LEN=*), intent(in) :: substring
type(varying_string) :: ins_string
integer :: start_
start_ = MAX(1, MIN(start, LEN(string)+1))
ins_string = var_str(string(:start_-1)//substring//string(start_:))
! Finish
return
end function insert_CH_CH
!| Remove a substring from a varying string
!
elemental function remove_VS (string, start, finish) result (rem_string)
type(varying_string), intent(in) :: string
integer, intent(in), optional :: start
integer, intent(in), optional :: finish
type(varying_string) :: rem_string
rem_string = remove(char(string), start, finish)
! Finish
return
end function remove_VS
!| Remove a substring from a character string
!
elemental function remove_CH (string, start, finish) result (rem_string)
character(LEN=*), intent(in) :: string
integer, intent(in), optional :: start
integer, intent(in), optional :: finish
type(varying_string) :: rem_string
integer :: start_
integer :: finish_
if(PRESENT(start)) then
start_ = MAX(1, start)
else
start_ = 1
endif
if(PRESENT(finish)) then
finish_ = MIN(LEN(string), finish)
else
finish_ = LEN(string)
endif
if(finish_ >= start_) then
rem_string = var_str(string(:start_-1)//string(finish_+1:))
else
rem_string = string
endif
! Finish
return
end function remove_CH
!| Replace part of a varying string with a varying substring
!
elemental function replace_VS_VS_auto (string, start, substring) result (rep_string)
type(varying_string), intent(in) :: string
integer, intent(in) :: start
type(varying_string), intent(in) :: substring
type(varying_string) :: rep_string
rep_string = replace(char(string), start, MAX(start, 1)+len(substring)-1, char(substring))
! Finish
return
end function replace_VS_VS_auto
!| Replace part of a character string with a varying substring
!
elemental function replace_CH_VS_auto (string, start, substring) result (rep_string)
character(LEN=*), intent(in) :: string
integer, intent(in) :: start
type(varying_string), intent(in) :: substring
type(varying_string) :: rep_string
rep_string = replace(string, start, MAX(start, 1)+len(substring)-1, char(substring))
! Finish
return
end function replace_CH_VS_auto
!| Replace part of a varying string with a character substring
!
elemental function replace_VS_CH_auto (string, start, substring) result (rep_string)
type(varying_string), intent(in) :: string
integer, intent(in) :: start
character(LEN=*), intent(in) :: substring
type(varying_string) :: rep_string
rep_string = replace(char(string), start, MAX(start, 1)+LEN(substring)-1, substring)
! Finish
return
end function replace_VS_CH_auto
!| Replace part of a character string with a character substring
!
elemental function replace_CH_CH_auto (string, start, substring) result (rep_string)
character(LEN=*), intent(in) :: string
integer, intent(in) :: start
character(LEN=*), intent(in) :: substring
type(varying_string) :: rep_string
rep_string = replace(string, start, MAX(start, 1)+LEN(substring)-1, substring)
! Finish
return
end function replace_CH_CH_auto
!| Replace part of a varying string with a varying substring
!
elemental function replace_VS_VS_fixed (string, start, finish, substring) result (rep_string)
type(varying_string), intent(in) :: string
integer, intent(in) :: start
integer, intent(in) :: finish
type(varying_string), intent(in) :: substring
type(varying_string) :: rep_string
rep_string = replace(char(string), start, finish, char(substring))
! Finish
return
end function replace_VS_VS_fixed
!| Replace part of a character string with a varying substring
!
elemental function replace_CH_VS_fixed (string, start, finish, substring) result (rep_string)
character(LEN=*), intent(in) :: string
integer, intent(in) :: start
integer, intent(in) :: finish
type(varying_string), intent(in) :: substring
type(varying_string) :: rep_string
rep_string = replace(string, start, finish, char(substring))
! Finish
return
end function replace_CH_VS_fixed
!| Replace part of a varying string with a character substring
!
elemental function replace_VS_CH_fixed (string, start, finish, substring) result (rep_string)
type(varying_string), intent(in) :: string
integer, intent(in) :: start
integer, intent(in) :: finish
character(LEN=*), intent(in) :: substring
type(varying_string) :: rep_string
rep_string = replace(char(string), start, finish, substring)
! Finish
return
end function replace_VS_CH_fixed
!| Replace part of a character string with a character substring
!
elemental function replace_CH_CH_fixed (string, start, finish, substring) result (rep_string)
character(LEN=*), intent(in) :: string
integer, intent(in) :: start
integer, intent(in) :: finish
character(LEN=*), intent(in) :: substring
type(varying_string) :: rep_string
integer :: start_
integer :: finish_
start_ = MAX(1, start)
finish_ = MIN(LEN(string), finish)
if(finish_ < start_) then
rep_string = insert(string, start_, substring)
else
rep_string = var_str(string(:start_-1)//substring//string(finish_+1:))
endif
! Finish
return
end function replace_CH_CH_fixed
!| Replace part of a varying string with a varying
! substring, at a location matching a varying-
! string target
!
elemental function replace_VS_VS_VS_target (string, target, substring, every, back) result (rep_string)
type(varying_string), intent(in) :: string
type(varying_string), intent(in) :: target
type(varying_string), intent(in) :: substring
logical, intent(in), optional :: every
logical, intent(in), optional :: back
type(varying_string) :: rep_string
rep_string = replace(char(string), char(target), char(substring), every, back)
! Finish
return
end function replace_VS_VS_VS_target
!| Replace part of a character string with a varying
! substring, at a location matching a varying-
! string target
!
elemental function replace_CH_VS_VS_target (string, target, substring, every, back) result (rep_string)
character(LEN=*), intent(in) :: string
type(varying_string), intent(in) :: target
type(varying_string), intent(in) :: substring
logical, intent(in), optional :: every
logical, intent(in), optional :: back
type(varying_string) :: rep_string
rep_string = replace(string, char(target), char(substring), every, back)
! Finish
return
end function replace_CH_VS_VS_target
!| Replace part of a character string with a varying
! substring, at a location matching a character-
! string target
!
elemental function replace_VS_CH_VS_target (string, target, substring, every, back) result (rep_string)
type(varying_string), intent(in) :: string
character(LEN=*), intent(in) :: target
type(varying_string), intent(in) :: substring
logical, intent(in), optional :: every
logical, intent(in), optional :: back
type(varying_string) :: rep_string
rep_string = replace(char(string), target, char(substring), every, back)
! Finish
return
end function replace_VS_CH_VS_target
!| Replace part of a character string with a varying
! substring, at a location matching a character-
! string target
!
elemental function replace_CH_CH_VS_target (string, target, substring, every, back) result (rep_string)
character(LEN=*), intent(in) :: string
character(LEN=*), intent(in) :: target
type(varying_string), intent(in) :: substring
logical, intent(in), optional :: every
logical, intent(in), optional :: back
type(varying_string) :: rep_string
rep_string = replace(string, target, char(substring), every, back)
! Finish
return
end function replace_CH_CH_VS_target
!| Replace part of a varying string with a character
! substring, at a location matching a varying-
! string target
!
elemental function replace_VS_VS_CH_target (string, target, substring, every, back) result (rep_string)
type(varying_string), intent(in) :: string
type(varying_string), intent(in) :: target
character(LEN=*), intent(in) :: substring
logical, intent(in), optional :: every
logical, intent(in), optional :: back
type(varying_string) :: rep_string
rep_string = replace(char(string), char(target), substring, every, back)
! Finish
return
end function replace_VS_VS_CH_target
!| Replace part of a character string with a character
! substring, at a location matching a varying-
! string target
!
elemental function replace_CH_VS_CH_target (string, target, substring, every, back) result (rep_string)
character(LEN=*), intent(in) :: string
type(varying_string), intent(in) :: target
character(LEN=*), intent(in) :: substring
logical, intent(in), optional :: every
logical, intent(in), optional :: back
type(varying_string) :: rep_string
rep_string = replace(string, char(target), substring, every, back)
! Finish
return
end function replace_CH_VS_CH_target
!| Replace part of a varying string with a character
! substring, at a location matching a character-
! string target
!
elemental function replace_VS_CH_CH_target (string, target, substring, every, back) result (rep_string)
type(varying_string), intent(in) :: string
character(LEN=*), intent(in) :: target
character(LEN=*), intent(in) :: substring
logical, intent(in), optional :: every
logical, intent(in), optional :: back
type(varying_string) :: rep_string
rep_string = replace(char(string), target, substring, every, back)
! Finish
return
end function replace_VS_CH_CH_target
!| Handle special cases when LEN(target) == 0. Such
! instances are prohibited by the standard, but
! since this function is elemental, no error can be
! thrown. Therefore, it makes sense to handle them
! in a sensible manner
!
elemental function replace_CH_CH_CH_target (string, target, substring, every, back) result (rep_string)
character(LEN=*), intent(in) :: string
character(LEN=*), intent(in) :: target
character(LEN=*), intent(in) :: substring
logical, intent(in), optional :: every
logical, intent(in), optional :: back
type(varying_string) :: rep_string
logical :: every_
logical :: back_
type(varying_string) :: work_string
integer :: length_target
integer :: i_target
if(LEN(target) == 0) then
if(LEN(string) /= 0) then
rep_string = string
else
rep_string = substring
endif
return
end if
! Replace part of a character string with a character
! substring, at a location matching a character-
! string target
if(PRESENT(every)) then
every_ = every
else
every_ = .false.
endif
if(PRESENT(back)) then
back_ = back
else
back_ = .false.
endif
rep_string = ''
work_string = string
length_target = LEN(target)
replace_loop : do
i_target = index(work_string, target, back_)
if(i_target == 0) exit replace_loop
if(back_) then
rep_string = substring//extract(work_string, start=i_target+length_target)//rep_string
work_string = extract(work_string, finish=i_target-1)
else
rep_string = rep_string//extract(work_string, finish=i_target-1)//substring
work_string = extract(work_string, start=i_target+length_target)
endif
if(.NOT. every_) exit replace_loop
end do replace_loop
if(back_) then
rep_string = work_string//rep_string
else
rep_string = rep_string//work_string
endif
! Finish
return
end function replace_CH_CH_CH_target
!| Split a varying string into two verying strings
!
elemental subroutine split_VS (string, word, set, separator, back)
type(varying_string), intent(inout) :: string
type(varying_string), intent(out) :: word
type(varying_string), intent(in) :: set
type(varying_string), intent(out), optional :: separator
logical, intent(in), optional :: back
call split_CH(string, word, char(set), separator, back)
! Finish
return
end subroutine split_VS
!| Split a varying string into two verying strings
!
elemental subroutine split_CH (string, word, set, separator, back)
type(varying_string), intent(inout) :: string
type(varying_string), intent(out) :: word
character(LEN=*), intent(in) :: set
type(varying_string), intent(out), optional :: separator
logical, intent(in), optional :: back
logical :: back_
integer :: i_separator
if(PRESENT(back)) then
back_ = back
else
back_ = .false.
endif
i_separator = scan(string, set, back_)
if(i_separator /= 0) then
if(back_) then
word = extract(string, start=i_separator+1)
if(PRESENT(separator)) separator = extract(string, start=i_separator, finish=i_separator)
string = extract(string, finish=i_separator-1)
else
word = extract(string, finish=i_separator-1)
if(PRESENT(separator)) separator = extract(string, start=i_separator, finish=i_separator)
string = extract(string, start=i_separator+1)
endif
else
word = string
if(PRESENT(separator)) separator = ''
string = ''
endif
! Finish
return
end subroutine split_CH
end module iso_varying_string
